      SUBROUTINE PACK (R,ARRAY,IARRAY,NTOT,MODE,NDIGIT,NTAP)
C
C     MASTER SUBROUTINE TO PACK OR UNPACK FLOATING POINT NUMBERS
C     PACKED ARRAY IS WRITTEN TO OR READ FROM TAPE WITH UNIT
C     NUMBER NTAP
C
C     ON IBM OR VAX MACHINES THIS SUBROUTINE SHOULD BE REPLACED BY
C     ONE THAT WRITES OR READS THE ARRAY R TO OR FROM DISC.
C
C     EACH RECORD OF PACKED FLOATINGS IS PRECEDED BY A TWO
C     WORD RECORD WITH INFORMATION ABOUT ITS STRUCTURE
C
C     HEADER (WORD 1) :
C     -----------------
C
C     BITS 00 - 14    : NUMBER OF DIGITS BEHIND DECIMAL POINT
C     BITS 15 - 29    : NUMBER OF F.P.NUMBERS PACKED IN ONE WORD
C     BITS 30 - 44    : TOTAL NUMBER OF F.P.NUMBERS TO BE PACKED
C     BITS 45 - 59    : TOTAL NUMBER OF F.P.NUMBERS THAT ARE ACTUALLY
C                       PACKED
C
C     HEADER (WORD 2) :
C     -----------------
C     BITS 00 - 59    : MINIMUM OF ARRAY ELEMENTS
C
C     SUBROUTINE CALL :
C
C     CALL PACK (R,ARRAY,IARRAY,NTOT,MODE,NDIGIT,NTAP)
C
C     R               : ARRAY TO BE PACKED OR THE RESULT OF UNPACKING
C     ARRAY           : DUMMY ARRAY (LENGTH = NTOT+60)
C     IARRAY          : DUMMY ARRAY TO BE EQUIVALENCED TO ARRAY
C                       IN MAIN (LENGTH = NTOT+60)
C     NTOT            : NUMBER OF ARRAY ELEMENTS IN R THAT ARE TO BE
C                       PACKED
C     MODE            : PACK  -- ARRAY WILL BE PACKED
C                     : UNPA  -- ARRAY WILL BE UNPACKED
C     NDIGIT          : NUMBER OF DIGITS BEHIND DECIMAL POINT
C     NTAP            : TAPE UNIT NUMBER FOR WRITING OR READING
C                       PACKED ARRAY
C
C     EXTERNALS       : SIZEI ( COMPASS )
C                     : PCK   ( COMPASS )
C                     : UCK   ( COMPASS )
C     FORMAT          : FTN4 SUBROUTINE
C
C     DATE            : DECEMBER 16 1980 (WFVG,NOV. 1981 / TR,APRIL 1984
C     AUTHOR          : HARRY T. JONKMAN
C
      DIMENSION ARRAY(*),IARRAY(*),R(*),INTER(12)
      CHARACTER*4 MODE
      IF(MODE.EQ.'PACK') GOTO 100
      IF(MODE.EQ.'UNPA') GOTO 200
      CALL ABORT('F',6,'UNKNOWN MODE:'//MODE//' IN CALL TO PACK',
     +0,0,R"PAC")
  100 IF (NTOT.LE.0) CALL ABORT('W',6,'ZERO WORDS PACKED BY PACK',0,0,0)
      IF (NTOT.GT.32767) CALL ABORT('F',6,'NTOT TOO LARGE IN PACK',
     +0,0,R"PAC")
      IRMIN= 9999999999
      IRMAX=-9999999999
      RSCALE=10.**NDIGIT
      DO 15 I=1,NTOT
      ARRAY(I)=RSCALE*R(I)
   15 IARRAY(I)=INT(ARRAY(I)+SIGN(.5,ARRAY(I)))
      DO 20 I=1,NTOT
      IF(IARRAY(I).GT.IRMAX) IRMAX=IARRAY(I)
      IF(IARRAY(I).LT.IRMIN) IRMIN=IARRAY(I)
   20 CONTINUE
      IDIFF=IRMAX-IRMIN
      CALL SIZEI(IDIFF,IPACK)
      NPACK=60/IPACK
      INTER(1)=NDIGIT
      INTER(2)=NPACK
      INTER(3)=NTOT
      DO 30 I=1,NTOT
   30 IARRAY(I)=IARRAY(I)-IRMIN
      NQ=NTOT+1
      NWORD=FLOAT(NTOT)/FLOAT(NPACK)+0.99
      MTOT=NWORD*NPACK
      INTER(4)=MTOT
      IF (NQ.GT.MTOT) GOTO 32
      DO 31 I=NQ,MTOT
   31 IARRAY(I)=IARRAY(NTOT)
   32 CONTINUE
      HEAD2=FLOAT(IRMIN)
      CALL PCK (4,INTER,IHEAD,4)
      CALL PCK(MTOT,IARRAY,IARRAY,NPACK)
      WRITE (NTAP) IHEAD,HEAD2
      WRITE (NTAP) (IARRAY(J),J=1,NWORD)
      GOTO 300
  200 READ (NTAP) INTER(4),HEAD2
      CALL UCK(4,INTER,INTER,4)
      IF (NDIGIT.NE.INTER(1).OR.(NTOT.NE.0.AND.NTOT.NE.INTER(3)))
     +CALL ABORT('F',6,'DATA INCONSISTENT WITH NDIGIT OR NTOT IN CALL TO
     + PACK',0,0,R"INP")
      NPACK=INTER(2)
      NTOT=INTER(3)
      MTOT=INTER(4)
      IF (MTOT.EQ.0) MTOT=NTOT
      RSCALE=1./(10.**NDIGIT)
      READ (NTAP) (IARRAY(J),J=NPACK,MTOT,NPACK)
      CALL UCK(MTOT,IARRAY,IARRAY,NPACK)
      DO 210 I=1,NTOT
      ARRAY(I)=FLOAT(IARRAY(I))
  210 R(I)=(ARRAY(I)+HEAD2)*RSCALE
  300 RETURN
      END
